home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr10 / swagabc.zip / CHARS.SWG < prev    next >
Text File  |  1993-06-01  |  12KB  |  1 lines

  1. SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00005         CHARACTER HANDLING                                                1      05-28-9313:33ALL                      SWAG SUPPORT TEAM        Manipulating the VGA FontIMPORT              18          {πDAVID DRZYZGAππ> Is there any way to create or use your own fonts inπ> regular Text mode With Pascal?ππHere's a demo of a routine originally posted by Bernie P and revised by me:π}ππProgram UpsideDown;π{-upsidedown and backwards Text aka redefining the Text mode font}πVarπ  newCharset,π  oldCharset : Array[0..255,1..16] of Byte;ππProcedure getoldCharset;πVarπ  b : Byte;π  w : Word;πbeginπ  For b := 0 to 255 doπ  beginπ    w := b * 32;π    Inline($FA);π    PortW[$3C4] := $0402;π    PortW[$3C4] := $0704;π    PortW[$3CE] := $0204;π    PortW[$3CE] := $0005;π    PortW[$3CE] := $0006;π    Move(Ptr($A000, w)^, oldCharset[b, 1], 16);π    PortW[$3C4] := $0302;π    PortW[$3C4] := $0304;π    PortW[$3CE] := $0004;π    PortW[$3CE] := $1005;π    PortW[$3CE] := $0E06;π    Inline($FB);π  end;πend;ππProcedure restoreoldCharset;πVarπ  b : Byte;π  w : Word;πbeginπ  For b := 0 to 255 doπ  beginπ    w := b * 32;π    Inline($FA);π    PortW[$3C4] := $0402;π    PortW[$3C4] := $0704;π    PortW[$3CE] := $0204;π    PortW[$3CE] := $0005;π    PortW[$3CE] := $0006;π    Move(oldCharset[b, 1], Ptr($A000, w)^, 16);π    PortW[$3C4] := $0302;π    PortW[$3C4] := $0304;π    PortW[$3CE] := $0004;π    PortW[$3CE] := $1005;π    PortW[$3CE] := $0E06;π    Inline($FB);π  end;πend;ππProcedure setasciiChar(Charnum : Byte; Var data);πVarπ  offset : Word;πbeginπ  offset := CharNum * 32;π  Inline($FA);π  PortW[$3C4] := $0402;π  PortW[$3C4] := $0704;π  PortW[$3CE] := $0204;π  PortW[$3CE] := $0005;π  PortW[$3CE] := $0006;π  Move(data, Ptr($A000, offset)^, 16);π  PortW[$3C4] := $0302;π  PortW[$3C4] := $0304;π  PortW[$3CE] := $0004;π  PortW[$3CE] := $1005;π  PortW[$3CE] := $0E06;π  Inline($FB);πend;ππProcedure newWriteln(s : String);π {- Reverses order of Characters written}πVarπ  b : Byte;πbeginπ  For b := length(s) downto 1 doπ    Write(s[b]);π  Writeln;πend;ππVarπ  b, c : Byte;ππbeginπ  getoldCharset;π  For b := 0 to 255 doπ    For c := 1 to 16 doπ      newCharset[b, c] := oldCharset[b, (17 - c)];π  For b := 0 to 255 doπ    setasciiChar(b, newCharset[b, 1]);π  newWriteln('Hello World!');π  readln;π  restoreoldCharset;πend.π                                                              2      05-28-9313:33ALL                      SWAG SUPPORT TEAM        Character Case           IMPORT              23          {πBO BendTSENππ  Upper/lower changing of Strings are always a difficult problem,π  but as a person living in Denmark i must normally care aboutπ  danish Characters, i know a lot of developers does not care aboutπ  international Character and just use the normal UPCASE routines.π  I advise you to use these routines or make some that has theπ  same effect, so we will not have any problems when searching forπ  uppercased Strings.ππ  Made available to everyone 1993 by Bo Bendtsen 2:231/111 +4542643827ππ     Lowcase   Upper/high/capital lettersπ              Æπ     ¢         ¥π     å         Åπ     ä         Äπ     ç         Çπ     é         Éπ     ö         Öπ     ñ         Ñπ     ü         Üππ}ππFunction UpChar(Ch : Char) : Char;π{ Uppercase a Char }πbeginπ  If Ord(Ch) In [97..122] Then Ch := Chr(Ord(Ch) - 32)π  Else If Ord(Ch) > 90 Thenπ    If Ch='' Then Ch:='Æ'π    Else If Ch='¢' Then Ch:='¥' Else If Ch='å' Then Ch:='Å'π    Else If Ch='ä' Then Ch:='Ä' Else If Ch='ç' Then Ch:='Ç'π    Else If Ch='é' Then Ch:='É' Else If Ch='ö' Then Ch:='Ö'π    Else If Ch='ñ' Then Ch:='Ñ' Else If Ch='ü' Then Ch:='Ü';π  UpChar:=Ch;πend;ππFunction StUpCase(S : String) : String;π{ Uppercase a String }πVarπ  SLen : Byte Absolute S;π  x    : Integer;πbeginπ  For x := 1 To SLen Do S[x]:=UpChar(S[x]);π  StUpCase := S;πend;ππFunction LowChar(Ch : Char) : Char;π{ lowercase a Char }πbeginπ  If Ord(Ch) In [65..90] Then Ch := Chr(Ord(Ch) + 32)π  Else If Ord(Ch) > 122 Thenπ    If Ch='Æ' Then Ch := ' 'π    Else If Ch='¥' Then Ch:='¢' Else If Ch='Å' Then Ch:='å'π    Else If Ch='Ä' Then Ch:='ä' Else If Ch='Ç' Then Ch:='ç'π    Else If Ch='É' Then Ch:='é' Else If Ch='Ö' Then Ch:='ö'π    Else If Ch='Ñ' Then Ch:='ñ' Else If Ch='Ü' Then Ch:='ü';π  LowChar := Ch;πend;ππFunction StLowCase(S : String) : String;π{ Lowercase a String }πVarπ  SLen : Byte Absolute S;π  i    : Integer;πbeginπ  For i := 1 To SLen Do S[i]:=LowChar(S[i]);π  StLowCase := S;πend;ππFunction StToggleCase(S : String) : String;π{ lower = upper and upper = lower }πVarπ  SLen : Byte Absolute S;π  i    : Integer;πbeginπ  For i := 1 To SLen Doπ  beginπ    If Ord(S[i]) In [65..90] Then S[i] := Chr(Ord(S[i]) + 32)π    Else If Ord(S[i]) In [97..122] Then S[i] := Chr(Ord(S[i]) - 32)π    Else If Pos(S[i],'¢åäçéöñü') <> 0 Then S[i]:=UpChar(S[i])π    Else If Pos(S[i],'ÆÅ¥ÇÄÖÉÜÑ')<> 0 Then S[i]:=LowChar(S[i]);π  end;π  StToggleCase := S;πend;ππFunction StSmartCase(S : String) : String;π{ bO bEnDTSen will be converted into : Bo Bendtsen }πVarπ  SLen : Byte Absolute S;π  i    : Integer;πbeginπ  s:=StLowCase(s);π  For i := 1 To SLen Doπ  beginπ    If i=1 Then S[1]:=UpChar(S[1])π    Else if S[i-1]=' ' Then S[i]:=UpChar(S[i])π    Else if (Ord(S[i-1]) In [32..64]) And (S[i-1]<>'''') ThenπS[i]:=UpChar(S[i]);π  end;π  StSmartCase := S;πend;π                   3      05-28-9313:33ALL                      SWAG SUPPORT TEAM        Switch Font Characters   IMPORT              27          {π> How can I redefine the ASCII Chars. For example how canπ> I make the ASCII code 65 become a "weird form" insteadπ> of an "A".ππYou want it, you got it.  Here are the two Procedures you need, plus someπinfo. First, you need to make a data Type With an Array of [1..16] of Byte,πso the best idea would be this:  Make a Record as follows:π}ππTypeπ  CharRec = Recordπ    data : Array[1..16] of Byte;π  end;ππ{ Now, make a Variable to contain the entire Character set. }ππVarπ  CharSet : Array[0..255] of CharRec;ππ{ Next, you'll need the two Procedures: }ππProcedure GetImageChar(chrVal : Byte; Var CharInfo);πVarπ  offset : Word;πbeginπ  offset := chrVal * 32;π  Inline($FA);π  PortW[$3C4] := $0402;π  PortW[$3C4] := $0704;π  PortW[$3CE] := $0204;π  PortW[$3CE] := $0005;π  PortW[$3CE] := $0006;π  (* refer to following notes For info about the next line *)π  Move(Ptr($A000, offset)^, CharInfo, 16);π  PortW[$3C4] := $0302;π  PortW[$3C4] := $0304;π  PortW[$3CE] := $0004;π  PortW[$3CE] := $1005;π  PortW[$3CE] := $0E06;π  Inline($FB);πend;ππ{πOK.  That's the Procedure to GET a Character bitmap, and store it in aπVariable.  So, if you use the Type and Var I defined at the top, do this:ππGetImageChar(65, CharSet[65]);ππThis example will copy the bitmap from Character 65 (A) into the Record of 65,πso you'll have copied the bitmap For 'A'.  Now, you can edit the bitmap (Iπwrote my own font editor) and Write it to memory With a second Procedure.ππHere's the tricky part.  I didn't Write the 2nd Procedure because it isπidentical to the first *EXCEPT* For ONE line.  Copy the Procedure and changeπit's name to SetImageChar, and change this line:ππMove(Ptr($A000, offset)^, CharInfo, 16);ππand make it read:ππMove(CharInfo, Ptr($A000, offset)^, 16);ππThat's it!  Have fun!  TTYL.π}ππ{πOK, 'data' is an Array [1..16] of Byte.  So, you just draw your Character onπGraph paper in binary, convert to decimal Bytes, put them in the Array, andπfeed it into this Procedure.  'CharNum' is the ASCII value of the Character youπwant to remap.  To make a Procedure that READS the bitmap instead of writing,πjust change the line With 'Move(data, Ptr($A000, offset)^, 16)' and make it sayπ'Move(Ptr($A000, offset)^, data, 16);' and you will now be able to read bitmapsπfrom the Character set.  I'm running out of time, so I can't explain it veryπwell, but I hope this helps.  TTYL.π}π{ππ  I ran that in a loop and after a While it screwed up the wholeπ  font - might just be my EGA card, but my opinion is that thisπ  method stinks...there are Registers For getting/setting theπ  font; I found code from a Program called Display Font Editorπ  (DFE).  DFE edits font Files, and it came With source toπ   load these font Files. Following is a bit from settingπ  the Registers to load a font (don't have getting a font)ππ  r.ax := $1110;π  r.bh := 14;                   (* Bytes per Character *)π  r.bl := 0;                    (* load to block 0 *)π  r.cx := 256;                  (* 256 Characters *)π  r.dx := 0;                    (* start With Character 0 *)π  r.es := Seg(P^);              (* segment of table *)π  r.bp := Ofs(P^);              (* offset of the table *)π  intr($10, r);ππ  With this, you can see, you can even do one Character at aπ  time ( cx = 1, dx = ascii, P^ = Array[1..14] of Byte)π}                             4      05-28-9313:33ALL                      SWAG SUPPORT TEAM        Read Screen CHARS        IMPORT              5           {πAuthor: A A OlowofoyekuππAs For reading the ASCII stuff from the screen, I have a routine thatπallows you to read a Character from any location on the screen.π}ππUsesπ  Dos;ππ{-- read the Character at the cursor and return it as a Char --}πFunction ScreenChar : Char;πVarπ  R : Registers;πbeginπ  FillChar(R, SizeOf(R), 0);π  R.AH := 8;π  R.BH := 0;π  Intr($10, R);π  ScreenChar := Chr(R.AL);πend;π                                                                                                                5      05-28-9313:33ALL                      SWAG SUPPORT TEAM        Redefine FONT Chars      IMPORT              22          {π>> I know this can be done - in fact I've seen posts on it before, but itπ>> didn't strike me as something to save at the time. . .π>  Does anyone know how to redefine the Characters used in Text mode?  Iπ>> don't want to use a whole new set; rather I'd like to change just about aπ>> dozen or so Characters to my own.ππThis is a little routine I developed sometime ago to redefine some of theπascii Chars as 'smileys'. The Arrays of hex values are Characterπbitmaps. There is a rather good article about doing this sort of thing in PCπMagazine,Volume 9 number 2 (Jan 30, 1990)π}ππProgram Redefine;ππUsesπ  Dos,Crt;ππProcedure loadChar;πConstπ  numnewChars = 6;πTypeπ  ByteArray = Array[0..15] of Byte;π  CharArray = Array[1..numnewChars] of Recordπ    CharNum : Byte;π    CharData : ByteArray;π  end;ππConst newChars : CharArray = (π   (CharNum : 21;π    CharData : ($00,$00,$E7,$A5,$E7,$00,$00,$08,$18,$38,$00,$00,$C3,$C3,$7E,$00)),π   (Charnum : 4;π    CharData : ($00,$00,$E7,$A5,$E7,$00,$00,$08,$18,$38,$00,$00,$7E,$C3,$C3,$00)),π   (Charnum : 19;π    CharData : ($AA,$AA,$FE,$00,$EE,$AA,$EE,$00,$08,$18,$38,$00,$C6,$C6,$7C,$00)),π   (Charnum : 17;π    CharData : ($03,$07,$FF,$00,$0E,$0A,$0E,$00,$00,$01,$03,$00,$08,$07,$00,$00)),π   (Charnum : 23;π    CharData : ($C0,$E0,$FF,$00,$E0,$A0,$E0,$00,$80,$80,$80,$10,$10,$E0,$00,$00)),π   (Charnum : 24;π    CharData : ($E7,$42,$00,$C3,$A5,$E7,$00,$08,$18,$38,$00,$00,$7E,$FF,$81,$00))π    );ππVarπ  r : Registers;π  i : Byte;ππbeginπfor i := 1 to numnewChars doπ  With r doπ  beginπ    ah := $11;             { video sub-Function $11 }π    al := $0;              { Load Chars to table }π    bh := $10;             { number of Bytes per Char }π    bl := 0;               { Character table to edit }π    cx := 1;               { number of Chars we're definig }π    dx := NewChars[i].CharNum;          { ascii value of the Char }π    es := seg(NewChars[i].CharData);    { es:bp --> table we're loading }π    bp := ofs(NewChars[i].CharData);π    intr($10,r);π  end;πend;ππbeginπ  loadChar;π  Writeln('Char(21) is now ',chr(21));Writeln;π  Writeln('Char(04) is now ',chr(04));Writeln;π  Writeln('Char(19) is now ',chr(19));Writeln;π  Writeln('Char(17) is now ',chr(17));Writeln;π  Writeln('Char(23) is now ',chr(23));Writeln;π  Writeln('Char(24) is now ',chr(24));Writeln;π  readln;π  Textmode(co80);π  Writeln('Char(21) is now ',chr(21));Writeln;π  Writeln('Char(04) is now ',chr(04));Writeln;π  Writeln('Char(19) is now ',chr(19));Writeln;π  Writeln('Char(17) is now ',chr(17));Writeln;π  Writeln('Char(23) is now ',chr(23));Writeln;π  Writeln('Char(24) is now ',chr(24));Writeln;πend.π